home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / prog / pas_all.zip / TI432.ASC < prev    next >
Text File  |  1991-09-11  |  11KB  |  397 lines
  1.  
  2.  
  3.  
  4.  
  5.  
  6.  
  7.  
  8.   PRODUCT  :  TURBO PASCAL                           NUMBER  :  432
  9.   VERSION  :  4.0
  10.        OS  :  PC-DOS 2.X, 3.X
  11.      DATE  :  MAY 3, 1988                              PAGE  :  1/6
  12.  
  13.     TITLE  :  PRINTING GRAPHICS TO A HEWLETT-PACKARD LASERJET
  14.  
  15.  
  16.  
  17.  
  18.   { The  following example routines are public domain programs }
  19.   { that have  been uploaded to our Forum on CompuServe.  As a }
  20.   { courtesy to our users that  do not have  immediate  access }
  21.   { to  CompuServe,  Technical   Support   distributes   these }
  22.   { routines free of charge.                                   }
  23.   {                                                            }
  24.   { However, because these routines are public domain programs,}
  25.   { not developed  by Borland International,  we are unable to }
  26.   { provide any  Technical  Support or  assistance using these }
  27.   { routines. If you need assistance  using  these   routines, }
  28.   { or   are   experiencing difficulties,  we  recommend  that }
  29.   { you log onto CompuServe  and request  assistance  from the }
  30.   { Forum members that developed  the routines.                }
  31.  
  32.   Unit HpCopy;
  33.   { This unit  is designed  to dump  graphics  images produced }
  34.   { by  Turbo  Pascal  4.0's  Graph  Unit to a Hewlett-Packard }
  35.   { LaserJet printer.                                          }
  36.   {                                                            }
  37.   { You  MUST set the  Aspect Ratio to 4950  before  drawing a }
  38.   { circular object on the screen. The procedure to accomplish }
  39.   { this is also contained in this handout.                    }
  40.   {                                                            }
  41.   { If the Aspect Ratio is NOT set, the image produced by this }
  42.   { routine will appear ellipsoid.                             }
  43.  
  44.   Interface
  45.  
  46.   Uses Crt, Dos, Graph;
  47.  
  48.   Var
  49.      LST : Text;      { MUST Redefine because Turbo's Printer }
  50.                       { Unit does not open  LST with the File }
  51.                       { Mode as BINARY.                       }
  52.  
  53.   Procedure HPHardCopy;
  54.   { Procedure to be  called when  the desired image is on the }
  55.   { screen.                                                   }
  56.  
  57.   Procedure SetAspectRatio( NewAspect : Word );
  58.   { Procedure to be called to set the aspect  ratio such that }
  59.   { circular  objects will  appear correctly on the  printout }
  60.   { generated  by  HpHardCopy.  NOTE that  the  image on  the }
  61.  
  62.  
  63.  
  64.  
  65.  
  66.  
  67.  
  68.  
  69.  
  70.  
  71.  
  72.  
  73.  
  74.   PRODUCT  :  TURBO PASCAL                           NUMBER  :  432
  75.   VERSION  :  4.0
  76.        OS  :  PC-DOS 2.X, 3.X
  77.      DATE  :  MAY 3, 1988                              PAGE  :  2/6
  78.  
  79.     TITLE  :  PRINTING GRAPHICS TO A HEWLETT-PACKARD LASERJET
  80.  
  81.  
  82.  
  83.  
  84.   { screen WILL appear ellipsoid.  This is NORMAL!            }
  85.  
  86.   Function GetAspectX : Word;
  87.   { This Function will return the  currently set aspect ratio }
  88.   { to allow the user  to save  the default ratio,  set it to }
  89.   { the ratio  required by HpHardCopy (4950) and then restore }
  90.   { it to the default value.                                  }
  91.  
  92.   Implementation
  93.  
  94.   Var
  95.      Width, Height : Word; { Variables used to store settings }
  96.      Vport : ViewPortType; { Used in the call GetViewSettings }
  97.  
  98.   {$F+}
  99.   Function LSTNoFunction ( Var F : TextRec ) : Integer;
  100.   { This  function performs a NUL  operation  for a  Reset or }
  101.   { Rewrite on LST.                                           }
  102.  
  103.   Begin
  104.      LSTNoFunction := 0;
  105.   End;
  106.  
  107.   Function LSTOutPutToPrinter( Var F : TextRec ) : Integer;
  108.   { LSTOutPutToPrinter  sends the output to the Printer port }
  109.   { number stored in the first byte of the  UserData area of }
  110.   { the Text Record.                                         }
  111.  
  112.   Var
  113.      Regs : Registers;
  114.      P : Word;
  115.  
  116.   Begin
  117.      With F Do
  118.      Begin
  119.         P := 0;
  120.         Regs.AH := 16;
  121.         While( P < BufPos ) and ( ( Regs.AH And 16 ) = 16 ) Do
  122.         Begin
  123.            Regs.AL := Ord( BufPtr^[P] );
  124.            Regs.AH := 0;
  125.            Regs.DX := UserData[1];
  126.            Intr( $17, Regs );
  127.  
  128.  
  129.  
  130.  
  131.  
  132.  
  133.  
  134.  
  135.  
  136.  
  137.  
  138.  
  139.  
  140.   PRODUCT  :  TURBO PASCAL                           NUMBER  :  432
  141.   VERSION  :  4.0
  142.        OS  :  PC-DOS 2.X, 3.X
  143.      DATE  :  MAY 3, 1988                              PAGE  :  3/6
  144.  
  145.     TITLE  :  PRINTING GRAPHICS TO A HEWLETT-PACKARD LASERJET
  146.  
  147.  
  148.  
  149.  
  150.            Inc( P );
  151.         End;
  152.         BufPos := 0;
  153.      End;
  154.      If( ( Regs.AH And 16 ) = 16 ) Then
  155.         LstOutPutToPrinter := 0         { No Error           }
  156.      Else
  157.         If( ( Regs.AH And 32 ) = 32 ) Then
  158.            LSTOutPutToPrinter := 159    { Out of Paper       }
  159.         Else
  160.            LSTOutPutToPrinter := 160;   { Device Write Fault }
  161.   End;
  162.   {$F-}
  163.  
  164.   Procedure AssignLST( Port : Byte );
  165.   { AssignLST both sets up the LST text file record as would }
  166.   { ASSIGN, and initializes it as would a RESET.             }
  167.   {                                                                                           }
  168.   { The parameter  passed to this  procedure  corresponds to }
  169.   { DOS's  LPT  number.  It is set  to 1 by default, but can }
  170.   { easily be  changed to any  LPT  number by  changing  the }
  171.   { parameter  passed  to  this  procedure  in  this  unit's }
  172.   { initialization code.                                     }
  173.  
  174.   Begin
  175.      With TextRec( Lst ) Do
  176.      Begin
  177.         Handle := $FFF0;
  178.         Mode := fmOutput;
  179.         BufSize := SizeOf( Buffer );
  180.         BufPtr := @Buffer;
  181.         BufPos := 0;
  182.         OpenFunc := @LSTNoFunction;
  183.         InOutFunc := @LSTOutPutToPrinter;
  184.         FlushFunc := @LSTOutPutToPrinter;
  185.         CloseFunc := @LSTOutPutToPrinter;
  186.         UserData[1] := Port - 1;
  187.      End;
  188.   End;
  189.  
  190.   Function GetAspectX : Word;
  191.  
  192.   Begin
  193.  
  194.  
  195.  
  196.  
  197.  
  198.  
  199.  
  200.  
  201.  
  202.  
  203.  
  204.  
  205.  
  206.   PRODUCT  :  TURBO PASCAL                           NUMBER  :  432
  207.   VERSION  :  4.0
  208.        OS  :  PC-DOS 2.X, 3.X
  209.      DATE  :  MAY 3, 1988                              PAGE  :  4/6
  210.  
  211.     TITLE  :  PRINTING GRAPHICS TO A HEWLETT-PACKARD LASERJET
  212.  
  213.  
  214.  
  215.  
  216.      GetAspectX := Word( Ptr( Seg( GraphFreeMemPtr ),
  217.                          Ofs( GraphFreeMemPtr ) + 277 ) ^ );
  218.   End;
  219.  
  220.   Procedure SetAspectRatio{ NewAspect : Word };
  221.  
  222.   Begin
  223.      Word( Ptr( Seg( GraphFreeMemPtr ),
  224.            Ofs( GraphFreeMemPtr ) + 277 ) ^ ) := NewAspect;
  225.   End;
  226.  
  227.   Procedure HPHardCopy;
  228.   { Produces hard copy of a graph on Hewlett-Packard Laserjet }
  229.   { printer By Joseph J. Hansen 9-15-87                       }
  230.   { Modified Extensively for compatibility with Version 4.0's }
  231.   { Graph Unit By Gary Stoker                                 }
  232.   {                                                           }
  233.   { Unlike Graphix Toolbox procedure HardCopy, this procedure }
  234.   { has no parameters, though it could easily be rewritten to }
  235.   { include  resolution in dots  per inch,  starting  column, }
  236.   { inverse image, etc.                                       }
  237.   {                                                           }
  238.  
  239.   Const DotsPerInch  = '100';
  240.                       { 100 dots per inch  gives  full-screen }
  241.                       { width of 7.2 inches for Hercules card }
  242.                       { graphs, 6.4 inches for IBM color card }
  243.                       { and 6.4  inches  for EGA card.  Other }
  244.                       { allowable values are 75, 150, and 300.}
  245.                       { 75  dots  per  inch  will  produce  a }
  246.                       { larger full-screen graph which may be }
  247.                       { too  large to  fit  on an  8 1/2 inch }
  248.                       { page; 150 and 300  dots per inch will }
  249.                       { produce smaller graphs                }
  250.  
  251.         CursorPosition = '5';
  252.                       { Column position of left side of graph }
  253.         Esc            = #27;
  254.                       { Escape character                      }
  255.  
  256.   Var LineHeader     : String[6];
  257.                       { Line  Header used for each  line sent }
  258.                       { to the LaserJet printer.              }
  259.  
  260.  
  261.  
  262.  
  263.  
  264.  
  265.  
  266.  
  267.  
  268.  
  269.  
  270.  
  271.  
  272.   PRODUCT  :  TURBO PASCAL                           NUMBER  :  432
  273.   VERSION  :  4.0
  274.        OS  :  PC-DOS 2.X, 3.X
  275.      DATE  :  MAY 3, 1988                              PAGE  :  5/6
  276.  
  277.     TITLE  :  PRINTING GRAPHICS TO A HEWLETT-PACKARD LASERJET
  278.  
  279.  
  280.  
  281.  
  282.       LineLength     : String[2];
  283.                       { Length  in  bytes of  the  line to be }
  284.                       { sent to the LaserJet.                 }
  285.       Y              : Integer;
  286.                       { Temporary loop Varible.               }
  287.  
  288.   Procedure DrawLine ( Y : Integer );
  289.   { Draws a single line of dots.  No of Bytes sent to printer }
  290.   { is Width + 1.  Argument of the procedure is the row no, Y }
  291.  
  292.   Var GraphStr       : String[255]; { String  used for OutPut }
  293.       Base           : Word;        { Starting   position  of }
  294.                                     { output byte.            }
  295.       BitNo,                        { Bit Number worked on    }
  296.       ByteNo,                       { Byte number worked on   }
  297.       DataByte       : Byte;        { Data Byte being built   }
  298.  
  299.   Begin
  300.     FillChar( GraphStr, SizeOf( GraphStr ), #0 );
  301.     GraphStr := LineHeader;
  302.     For ByteNo := 0 to Width  Do
  303.     Begin
  304.       DataByte := 0;
  305.       Base := 8 * ByteNo;
  306.       For BitNo := 0 to 7 Do
  307.       Begin
  308.         If GetPixel( BitNo+Base, Y ) > 0
  309.            Then
  310.              Begin
  311.                 DataByte := DataByte + 128 Shr BitNo;
  312.              End;
  313.       End;
  314.       GraphStr := GraphStr + Chr (DataByte)
  315.     End;
  316.  
  317.     Write (Lst, GraphStr)
  318.  
  319.   End; {Of Drawline}
  320.  
  321.   Begin {Main procedure HPCopy}
  322.     FillChar( LineLength, SizeOf( LineLength ), #0 );
  323.     FillChar( LineHeader, SizeOf( LineHeader ), #0 );
  324.  
  325.  
  326.  
  327.  
  328.  
  329.  
  330.  
  331.  
  332.  
  333.  
  334.  
  335.  
  336.  
  337.  
  338.   PRODUCT  :  TURBO PASCAL                           NUMBER  :  432
  339.   VERSION  :  4.0
  340.        OS  :  PC-DOS 2.X, 3.X
  341.      DATE  :  MAY 3, 1988                              PAGE  :  6/6
  342.  
  343.     TITLE  :  PRINTING GRAPHICS TO A HEWLETT-PACKARD LASERJET
  344.  
  345.  
  346.  
  347.  
  348.     GetViewSettings( Vport );
  349.     Width := ( Vport.X2 + 1 ) - Vport.X1;
  350.     Width := ( ( Width - 7 ) Div 8 );
  351.     Height := Vport.Y2 - Vport.Y1;
  352.  
  353.     Write (Lst, Esc + 'E');                 { Reset Printer   }
  354.     Write (Lst, Esc+'*t'+DotsPerInch+'R');  { Set density in  }
  355.                                             { dots per inch   }
  356.     Write (Lst, Esc+'&a'+CursorPosition+'C');{ Move cursor to }
  357.                                             { starting col    }
  358.     Write (Lst, Esc + '*r1A');        { Begin raster graphics }
  359.  
  360.     Str (Width + 1, LineLength);
  361.     LineHeader := Esc + '*b' + LineLength + 'W';
  362.  
  363.  
  364.     For Y := 0 To Height + 1 Do
  365.     Begin
  366.       DrawLine ( Y );
  367.       DrawLine ( Y );
  368.     End;
  369.  
  370.     Write (Lst, Esc + '*rB');           { End Raster graphics }
  371.     Write (Lst, Esc + 'E');             { Reset  printer  and }
  372.                                         { eject page          }
  373.   End;
  374.  
  375.   Begin
  376.      AssignLST( 1 );        { This is the parameter to change }
  377.                             { if you  want  the output  to be }
  378.                                { directed  to  a  different  LST }
  379.                             { device.                         }
  380.   End.
  381.  
  382.  
  383.  
  384.  
  385.  
  386.  
  387.  
  388.  
  389.  
  390.  
  391.  
  392.  
  393.  
  394.  
  395.  
  396.  
  397.